Effect of housing benefits on housing overburden
Comparison of housing precarity dimensions with and without housing
benefits can be made easily only for housing overburden (by calculating
overburden based on income with housing benefits and without housing
benefits). This assumes that the households would not move if they did
not receive housing benefits. Comparison of other dimensions require
some modelling.
tar_load(all_silc_households)
all_silc_households %>%
select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>%
pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>%
mutate(type = case_when(
grepl("wo_hb", type) ~ "Without housing benefits",
!grepl("wo_hb", type) ~ "With housing benefits"
)) %>%
ggplot(., aes(x = year, y = pct, colour = type)) +
geom_point(alpha = 0.8) +
scale_colour_viridis_d() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
labs(x = "Year", y = "Share of households",
title = "Housing overburden",
colour = "") +
theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>%
pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb),
names_to = "income_type", values_to = "income_share_on_housing") %>%
mutate(income_type = if_else(income_type == "income_share_on_housing",
"With housing benefits",
"Without housing benefits")) %>%
ggplot(., aes(x = income_share_on_housing, colour = income_type)) +
geom_density() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
labs(x = "Income share on housing", y = "Density", colour = "Income") +
theme(legend.position = "top")
## Warning: Removed 12260 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb,
hh_cross_weight) %>%
mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>%
group_by(country) %>%
summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight,
na.rm = TRUE)) %>%
arrange(desc(mean_reduction_income_share)) %>%
knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
| FI |
2.18 |
| IE |
1.38 |
| DE |
1.21 |
| NL |
1.17 |
| SE |
1.09 |
| DK |
1.06 |
| FR |
1.01 |
| AT |
0.78 |
| CZ |
0.46 |
| LT |
0.26 |
| LV |
0.25 |
| NO |
0.23 |
| EE |
0.19 |
| BE |
0.16 |
| CY |
0.14 |
| LU |
0.12 |
| MT |
0.10 |
| SI |
0.07 |
| HU |
0.06 |
| HR |
0.06 |
| ES |
0.06 |
| PL |
0.04 |
| IT |
0.04 |
| PT |
0.01 |
| EL |
0.01 |
| BG |
0.00 |
| RO |
0.00 |
| SK |
0.00 |
Tenants
tar_load(all_silc_households_tenants)
all_silc_households_tenants %>%
select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>%
pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>%
mutate(type = case_when(
grepl("wo_hb", type) ~ "Without housing benefits",
!grepl("wo_hb", type) ~ "With housing benefits"
)) %>%
ggplot(., aes(x = year, y = pct, colour = type)) +
geom_point(alpha = 0.8) +
scale_colour_viridis_d() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
scale_y_continuous(labels = scales::label_percent(scale = 1)) +
labs(x = "Year", y = "Share of households",
title = "Housing overburden",
subtitle = "Tenants",
colour = "") +
theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(tenure_status %in% c("Tenant, rent at market price",
"Tenant, rent at reduced price",
"Tenant, rent free")) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>%
pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb),
names_to = "income_type", values_to = "income_share_on_housing") %>%
mutate(income_type = if_else(income_type == "income_share_on_housing",
"With housing benefits",
"Without housing benefits")) %>%
ggplot(., aes(x = income_share_on_housing, colour = income_type)) +
geom_density() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
labs(x = "Income share on housing", y = "Density", colour = "Income") +
theme(legend.position = "top")
## Warning: Removed 2298 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(tenure_status %in% c("Tenant, rent at market price",
"Tenant, rent at reduced price",
"Tenant, rent free")) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb,
hh_cross_weight) %>%
mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>%
group_by(country) %>%
summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight,
na.rm = TRUE)) %>%
arrange(desc(mean_reduction_income_share)) %>%
knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
| FI |
5.58 |
| IE |
3.40 |
| NL |
2.75 |
| SE |
2.43 |
| FR |
2.43 |
| DK |
2.15 |
| DE |
1.97 |
| CZ |
1.37 |
| AT |
1.15 |
| LV |
0.65 |
| NO |
0.46 |
| LT |
0.38 |
| CY |
0.35 |
| MT |
0.33 |
| BE |
0.31 |
| SI |
0.28 |
| EE |
0.28 |
| PL |
0.24 |
| LU |
0.24 |
| ES |
0.19 |
| HR |
0.16 |
| IT |
0.10 |
| PT |
0.06 |
| HU |
0.05 |
| BG |
0.00 |
| EL |
0.00 |
| RO |
0.00 |
| SK |
0.00 |
Owners
tar_load(all_silc_households_owners)
all_silc_households_owners %>%
select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>%
pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>%
mutate(type = case_when(
grepl("wo_hb", type) ~ "Without housing benefits",
!grepl("wo_hb", type) ~ "With housing benefits"
)) %>%
ggplot(., aes(x = year, y = pct, colour = type)) +
geom_point(alpha = 0.8) +
scale_colour_viridis_d() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
scale_y_continuous(labels = scales::label_percent(scale = 1)) +
labs(x = "Year", y = "Share of households",
title = "Housing overburden",
subtitle = "Owners",
colour = "") +
theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(tenure_status %in% c("Owner without outstanding mortgage",
"Owner with outstanding mortgage")) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>%
pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb),
names_to = "income_type", values_to = "income_share_on_housing") %>%
mutate(income_type = if_else(income_type == "income_share_on_housing",
"With housing benefits",
"Without housing benefits")) %>%
ggplot(., aes(x = income_share_on_housing, colour = income_type)) +
geom_density() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
labs(x = "Income share on housing", y = "Density", colour = "Income") +
theme(legend.position = "top")
## Warning: Removed 9108 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(tenure_status %in% c("Owner without outstanding mortgage",
"Owner with outstanding mortgage")) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb,
hh_cross_weight) %>%
mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>%
group_by(country) %>%
summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight,
na.rm = TRUE)) %>%
arrange(desc(mean_reduction_income_share)) %>%
knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
| IE |
0.43 |
| AT |
0.37 |
| LT |
0.24 |
| SE |
0.20 |
| EE |
0.17 |
| LV |
0.15 |
| DE |
0.12 |
| CZ |
0.11 |
| FI |
0.09 |
| BE |
0.08 |
| HU |
0.06 |
| LU |
0.06 |
| HR |
0.05 |
| NO |
0.05 |
| FR |
0.03 |
| DK |
0.02 |
| CY |
0.02 |
| ES |
0.02 |
| IT |
0.01 |
| MT |
0.01 |
| NL |
0.01 |
| EL |
0.01 |
| PL |
0.01 |
| PT |
0.00 |
| BG |
0.00 |
| RO |
0.00 |
| SI |
0.00 |
| SK |
0.00 |
All
diff_all <- all_silc_households %>%
mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>%
group_by(country) %>%
summarise(mean_diff_overburden = round(mean(diff, na.rm = TRUE), 2),
.groups = "drop") %>%
arrange(desc(mean_diff_overburden))
diff_tenants <- all_silc_households_tenants %>%
mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>%
group_by(country) %>%
summarise(mean_diff_overburden_tenants = round(mean(diff, na.rm = TRUE), 2),
.groups = "drop") %>%
arrange(desc(mean_diff_overburden_tenants))
diff_owners <- all_silc_households_owners %>%
mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>%
group_by(country) %>%
summarise(mean_diff_overburden_owners = round(mean(diff, na.rm = TRUE), 2),
.groups = "drop") %>%
arrange(desc(mean_diff_overburden_owners))
Average
purrr::reduce(list(diff_all, diff_tenants, diff_owners),
~full_join(.x, .y, by = "country")) %>%
mutate(ratio = mean_diff_overburden_tenants / mean_diff_overburden_owners) %>%
knitr::kable(., col.names = c("Country", "Overburden diff. (all)",
"Overburden diff. (tenants)",
"Overburden diff. (owners)",
"Ratio"),
digits = 2)
| NO |
10.33 |
7.03 |
6.24 |
1.13 |
| FR |
2.24 |
5.66 |
0.06 |
94.33 |
| SE |
1.77 |
3.19 |
0.81 |
3.94 |
| DK |
1.73 |
3.51 |
0.02 |
175.50 |
| DE |
1.48 |
2.50 |
0.14 |
17.86 |
| NL |
1.25 |
3.00 |
0.01 |
300.00 |
| FI |
1.20 |
3.01 |
0.09 |
33.44 |
| IE |
1.11 |
3.22 |
0.19 |
16.95 |
| AT |
0.46 |
0.87 |
0.01 |
87.00 |
| CY |
0.39 |
0.88 |
0.11 |
8.00 |
| LV |
0.39 |
0.83 |
0.28 |
2.96 |
| CZ |
0.37 |
1.05 |
0.15 |
7.00 |
| CH |
0.31 |
0.50 |
0.00 |
Inf |
| LT |
0.27 |
0.60 |
0.22 |
2.73 |
| EE |
0.15 |
0.40 |
0.08 |
5.00 |
| PL |
0.13 |
0.52 |
0.04 |
13.00 |
| SI |
0.12 |
0.46 |
0.00 |
Inf |
| ES |
0.11 |
0.34 |
0.03 |
11.33 |
| HU |
0.11 |
0.16 |
0.10 |
1.60 |
| HR |
0.09 |
0.25 |
0.07 |
3.57 |
| LU |
0.09 |
0.22 |
0.03 |
7.33 |
| IT |
0.05 |
0.17 |
0.01 |
17.00 |
| RS |
0.05 |
0.08 |
0.05 |
1.60 |
| PT |
0.04 |
0.10 |
0.02 |
5.00 |
| RO |
0.02 |
0.04 |
0.02 |
2.00 |
| EL |
0.01 |
0.01 |
0.01 |
1.00 |
| MT |
0.01 |
0.03 |
0.01 |
3.00 |
| BG |
0.00 |
0.00 |
0.00 |
NaN |
| SK |
0.00 |
0.00 |
0.00 |
NaN |
| BE |
-0.10 |
-0.14 |
0.00 |
Inf |
| IS |
NaN |
NaN |
NaN |
NaN |
| UK |
NaN |
NaN |
NaN |
NaN |
Income quantiles
silc_merged_households %>%
ungroup() %>%
group_by(country, year, income_disposable_eqi_quantile) %>%
filter(!is.na(income_disposable_eqi_quantile)) %>%
summarise(housing_overburden =
wtd.mean(housing_overburden, hh_cross_weight,
na.rm = TRUE),
housing_overburden_wo_hb =
wtd.mean(housing_overburden_wo_hb, hh_cross_weight,
na.rm = TRUE), .groups = "drop") %>%
select(country, year, income_disposable_eqi_quantile,
housing_overburden, housing_overburden_wo_hb) %>%
pivot_longer(., cols = c(housing_overburden,
housing_overburden_wo_hb), names_to = "overburden",
values_to = "share") %>%
filter(overburden == "housing_overburden") %>%
ggplot(., aes(x = year, y = share,
colour = income_disposable_eqi_quantile
# shape = overburden
)) +
geom_point(alpha = 0.8) +
scale_colour_viridis_d() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
scale_y_continuous(labels = scales::label_percent(scale = 100)) +
labs(x = "Year", y = "Share of households",
title = "Housing overburden",
colour = "Equalised disposable income") +
theme(legend.position = "top")
## Warning: Removed 5 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(!is.na(income_disposable_eqi_quantile)) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, income_disposable_eqi_quantile,
hh_cross_weight) %>%
mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>%
group_by(country, income_disposable_eqi_quantile) %>%
summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight,
na.rm = TRUE)) %>%
ggplot(., aes(x = income_disposable_eqi_quantile, y = mean_reduction_income_share)) +
geom_point() +
coord_flip() +
facet_wrap(~country) +
theme_minimal() +
labs(y = "Mean reduction of income share on housing (perc. points)",
x = "Quantile of equalised disposable income")
## `summarise()` has grouped output by 'country'. You can override using the
## `.groups` argument.

Economic activity
silc_merged_households %>%
ungroup() %>%
group_by(country, year, econ_status) %>%
filter(!is.na(econ_status)) %>%
# filter(econ_status != "Other") %>%
mutate(econ_status = case_when(
econ_status == "Employed" ~ "Employed",
econ_status == "Retired" ~ "Retired",
econ_status %in% c("Unemployed", "Fulfilling domestic tasks",
"Unable to work due to health problems") ~ "Inactive (unemployed, unable to work, at home)",
econ_status %in% c("Student", "Other") ~ "Other",
)) %>%
summarise(housing_overburden =
wtd.mean(housing_overburden, hh_cross_weight,
na.rm = TRUE),
housing_overburden_wo_hb =
wtd.mean(housing_overburden_wo_hb, hh_cross_weight,
na.rm = TRUE), .groups = "drop") %>%
select(country, year, econ_status,
housing_overburden, housing_overburden_wo_hb) %>%
pivot_longer(., cols = c(housing_overburden,
housing_overburden_wo_hb), names_to = "overburden",
values_to = "share") %>%
filter(overburden == "housing_overburden") %>%
ggplot(., aes(x = year, y = share,
colour = econ_status
# shape = overburden
)) +
geom_point(alpha = 0.8) +
scale_colour_viridis_d() +
facet_wrap(~country, scales = "free_y") +
theme_minimal() +
scale_y_continuous(labels = scales::label_percent(scale = 100)) +
labs(x = "Year", y = "Share of households",
title = "Housing overburden",
colour = "Econ. status") +
theme(legend.position = "top")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>%
ungroup() %>%
filter(year == 2023) %>%
filter(!is.na(econ_status)) %>%
select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, econ_status,
hh_cross_weight) %>%
mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>%
group_by(country, econ_status) %>%
summarise(mean_reduction_income_share =
wtd.mean(diff_pp, hh_cross_weight, na.rm = TRUE)) %>%
ggplot(., aes(x = econ_status, y = mean_reduction_income_share)) +
geom_point() +
coord_flip() +
facet_wrap(~country) +
theme_minimal() +
labs(y = "Mean reduction of income share on housing (perc. points)",
x = "Econ. status")
## `summarise()` has grouped output by 'country'. You can override using the
## `.groups` argument.
